perm filename MFAIL.FAI[NEW,LCS]2 blob sn#322679 filedate 1977-12-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE SMALL
C00011 ENDMK
CāŠ—;
	TITLE SMALL
	INTERNAL RJBX,CENTX,EXTEN,JDRAW,CENTER,LINX,UNPACK,ROFF
	INTERNAL NOZERO,EXCH,BMS,IABS,RHORZ,ABS,RTLINE,FLOAT,IFIX
	EXTERNAL .COMM.,STF,POSI,LL,LINES,BM,XRN,AMOD,PLTR,THICK



RJBX:	0		;R3=R3+R*RSTJ2
	MOVE 2,@(16)
	FMPR 	2,STF+=8
	FADRM	2,.COMM.+=4
	JRA	16,1(16)

CENTX:	0	;CENTX=POS-18.*RSTJ2+AMOD(R4,100.0)*RSTJ2*7.
	JSA 	16,AMOD
	JUMP	.COMM.+5
	JUMP	[=100.0]	; -81 TURNS TO 19, 81 TURNS TO -19!!!
	CAMGE   [-80.0] 	 	;IF(R4.LT.-80)R4=R4+100
	FADR	[100.0] 	 	; CATCHES R4=-95  ETC.
	CAML	[80.0]   		;IF(R4.GE.80)R4=R4-100
	FSBR	[100.0] 	 	; CATCHES NEG. MINIS ETC.
	MOVEM .COMM.+5		;[R4=AMOD(R4,100.0)]***********
	FMPR	[=7.0]
	FSBR	[=18.0]
	FMPR	STF+=8
	FADR	POSI+=9
	MOVEM	.COMM.+2
	JRA	16,(16)


EXTEN:	0	;FUNCTION EXTEN(X)
	HRRM	16,.+2
	JSA	16,AMOD	;EXTEN=AMOD(X,1.)*10.
	JUMP 	@0
	JUMP	[=1.0]
	FMPR	[=10.0]
	JRA	16,1(16)



JDRAW:	0	;SUBROUTINE JDRAW(M,R3,CENTR,RSTJ2,RX,RY)
				;COMMON/LL/LL
	MOVE	13,@4(16)	;DIMENSION M(1)
	FMPR	13,@3(16)		;RC=RX*RSTJ2
	MOVE	14,@5(16)	;RD=RY*RSTJ2
	FMPR	14,@3(16)	;13 HAS RC,  14 HAS RD
	MOVE	3,@(16)		;DO 2 K=2,M(1)
	HRRZ	12,(16)  ; BRING IN ADR. OF M (ZERO LEFT HALF)
	MOVE	10,(12)		;PUT ADR. OF M IN 10
	ADDI	10,-1(12)
L2:	AOJ	12,	; SET UP LOOP
	CAILE	12,(10)	; SEE IF WE'VE PASSED END OF LOOP
	JRA	16,6(16)	; GO HOME
	HRRZM	12,.+4	; PUT ADR. OF VALUE M(K) IN LAST JUMP
; CALL UNPACK(A,B,M(K))
	JSA	16,UNPACK
	JUMP	6	;AA
	JUMP	7	;BB
	JUMP
;2  CALL LINES(FLOAT(A)*RC+R3,FLOAT(B)*RD+CENTR,LL)
	FLTR 6,6
	FMPR	6,13
	FADR	6,@1(16)
   	FLTR 7,7
	FMPR	7,14
	FADR	7,@2(16)
	JSA	16,LINES
	JUMP	6		;AA
	JUMP	7	;BB
	JUMP	LL
	JRST	L2

CENTER:	0    ;	SUBROUTINE CENTER(CNTR)
;  TO CENTER ITEMS CREATED WITH DRAWING PROG.
	;	COMMON /STF/RSTFAC(8),RSTJ2
	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	;	COMMON/POSI/STF(8),JJ2,POS
	;	EQUIVALENCE (R4,RJQ(2))
	JSA	16,AMOD    ;CNTR=POS+(2+AMOD(R4,100.)*7)*RSTJ2
	JUMP	.COMM.+5
	JUMP	[=100.0]
	FMPR	[=7.0]
	FADR	[=2.0]
	FMPR	STF+=8
	FADR	POSI+=9
	MOVEM	@(16)
	JRA	16,1(16)

LINX:	0	; SUBROUTINE LINX(A,B,C,D)
; C  SAVES SPACE FOR SINGLE LINES.
	MOVE	4,@(16)	;CALL LINES(A,B,3)
	MOVE	6,@1(16)
;CALL LINES(C,D,2)
	JSA	16,LINES
	JUMP 4
	JUMP 6
	JUMP	[=3]
	MOVE	6,@2(16) 
;; 6 AND 4 ARE FREE IN LINES  	MOVEM	CC
	MOVE	4,@3(16)
	JSA	16,LINES
	JUMP	6
	JUMP	4
	JUMP	[=2]
	JRA	16,4(16)

UNPACK:	0  ;	SUBROUTINE UNPACK(M,N,I)
	;	COMMON/LL/L
;C  L IS FOR VIS. OR INVIS. LINES.
	MOVEI	1,2	; L=2
 	MOVE	2,@2(16)	; N=I
	MOVE 4,2
	IDIV	2,[=100000000]  ;  M=N/100000000
	JUMPE	2,M2		; IF(M.EQ.0)GO TO 2
	AOJ 1,		; L=3
	MOVE 4,3		; N=N-100000000*M
M2:	MOVEM	1,LL
	IDIVI	4,23420    ;2	M=N/10000
			; 5 IS  N=MOD(N,10000)
	CAIG	4,1750	; IF(M.GT.1000)M=1000-M
	JRST	N2
	MOVNS 4
	ADDI 4,1750
N2:	CAIG 5,1750	; IF(N.GT.1000)N=1000-N
	JRST	P2
	MOVNS 5
	ADDI 5,1750
P2:	MOVEM	4,@(16)
	MOVEM	5,@1(16)
	JRA	16,3(16)

ROFF:	0	; FUNCTION ROFF(R)
	SKIPGE	1,@(16)   ; IF(R)S=-S
	JRST ROFF1
	MOVE [0.5]        ; S=.5
	FADR  1           ; ROFF=R+S
	JRA	16,1(16)
ROFF1:	MOVN [0.5]
	JRST .-3

NOZERO:	0	;SUBROUTINE NOZERO(X)
	SKIPE	@(16)	; IF(X.EQ.0)X=1
	JRA	16,1(16)
	MOVSI 201400  	; MAKE ALL ZEROS INTO ONES.
	MOVEM	@(16)
	JRA	16,1(16)

EXCH:	0	; SUBROUTINE EXCH(X,Y)
	MOVE	@(16)
	EXCH	0,@1(16)
	MOVEM	0,@(16)
	JRA	16,2(16)

BMS:	0    	;	SUBROUTINE BMS
	MOVE	BM+1 ;COMMON/STF/RSTFAC(-3/4),RSTJ2/BM/RA,RC,RKY
	FMPR	STF+=8	; CALL LINES(RA,RJY+RC*RSTJ2,2)
	FADR	BM+2
	MOVEM	CENTX
	JSA	16,LINES	;	END
	JUMP	BM
	JUMP	CENTX
	JUMP	[2]
	JRA	16,(16)

ABS:	0
	SKIPA
IABS:	0     		; FUNCTION IABS(N)
 	MOVM 0,@(16)  ;BECAUSE IABS IN LIB40 HAS A BUG.
	JRA	16,1(16)    	; IABS=N  ; IF(N)IABS=-N

RHORZ:	0  		; FUNCTION RHORZ(R)
	MOVE	@(16)  	; RHORZ=R*5.96-596.
	FMPR	[=5.96]
	FSBR	[=596.0]
	JRA	16,1(16)

RTLINE:	0	;FUNCTION RTLINE(L)
	MOVE 2,.COMM. ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
;%%%%%%	CAMLE	2,[=4.0] ;RTLINE=-1
	CAMLE	2,[=7.0] ;RTLINE=-1
	JRST 	ZRO	;IF(R2.GT.4)GO TO 1 %%%%%.GT.7
			;IF(RN(L+2).NE.R2)RETURN
	MOVE 3,@(16)		; 1  RTLINE=0
	SETO
	CAMN 2,XRN+1(3)
ZRO:	SETZ
	JRA	16,1(16)

FLOAT: 	0
	FLTR	0,@(16)
	JRA	16,1(16)
IFIX:   0
	MOVE 	0,@(16)
	JUMPGE	0,.+5
	MOVNS	0
	KIFIX
	MOVNS	0
	JRA	16,1(16)
	KIFIX
	JRA	16,1(16)

THICK:	0    ;RETURNS NUMBER OF THICKNESSES IN J8 AND "SCALED" STEP IN R8
; NEXT J8 = 1→99 =X THICKNESS, =100→ = Y THICKNESS
	JSA 16,AMOD		;	R8=AMOD(R8,100.0)
	JUMP .COMM.+=9
	JUMP [100.0]
	MOVE 1,.COMM.+=29	; 	J9=J8/100
	IDIVI 1,=100		;
	KIFIX 3,0		;	J8=R8
	SETO 2,	 		;	J4=-1
; FLAG FOR SINGLE ADDED VERTICAL THICKNESS, NO MATTER WHAT SIZE. R8=.5
 	FLTR 3,3
	CAME 3,0		;	IF(R8.NE.J8)J4=0
	SETZ 2,
	MOVE 4,STF+=8		;	R9=RSTJ2*DIS
;  R8 AND R9 ARE FACTORS TO CAUSE RIGHT NUM OF LINES FOR THICKNESS.
	FMPR 4,PLTR+2
	FMPR 0,4		;	J8=J8*R9
	FLTR 1,1		;	J9=J9*R9
	FMPR 1,4
	SKIPE 1			;	IF(J9.NE.0.AND.J8.NE.0)J9=J8
	SKIPN 0
	SKIPA
	MOVE 1,0
;  IF BOTH X AND Y THICKNESS IS USED THEY WILL BECOME EQUAL!
	MOVE 3,[1.0]		
;;	JUMPL 2,TH1		;	IF(J4)GO TO 1 
	SKIPL 2
	MOVE 1,[1.0]		;	J9=1
; SINGLE ADDED THICKNESS, NO MATTER WHAT SIZE.;	R8=1
;;	SKIPA
;;TH1:	FDVR 3,PLTR+2		;	R8=1/DIS
;;	MOVEM 3,.COMM.+=9
	KIFIX 0,0
	MOVEM 0,.COMM.+=29	;  J8
	KIFIX 1,1
	MOVEM 1,.COMM.+=30	;  J9
	JRA 16,(16)
	END